home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / sys / sunkernel.t < prev    next >
Text File  |  1988-02-12  |  14KB  |  341 lines
  1. (herald sunkernel
  2.   (env tsys))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; The procedure big_bang MUST come first in this file.     boot-arg-offset
  28. ;;;  When we enter Big_bang the stack looks as follows:
  29. ;;;              ________________
  30. ;;;              |   debug?      |   not a boot arg
  31. ;;;              |_______________|
  32. ;;;              |      argv     |    Command line argv
  33. ;;;              |_______________|
  34. ;;;              |      argc     |    Command line argc
  35. ;;;              |_______________|
  36. ;;;              |  heap-size    |    Size of the static storage area
  37. ;;;              |_______________|
  38. ;;;              |     heap2     | Base addresss of static
  39. ;;;              |_______________|        storage area
  40. ;;;              |     heap1     |
  41. ;;;              |_______________|
  42. ;;;       SP =>  |  return addr  |
  43. ;;;              |_______________|
  44.  
  45.  
  46. ;++ replace the numbers 1 and 3 below with boot/heap1 and boot/heap-size
  47.  
  48.  
  49. (define (big_bang) 
  50.   (lap (*the-slink* m68-big-bang *boot*)
  51.  
  52.     ;; set up global-constants
  53.     (move .l  (d@static P (static '*the-slink*)) nil-reg)
  54.     (asl .l ($ 2) S0)
  55.     (move .l  S0 (d@nil slink/interrupt-handler))    ; interrupt_xenoid
  56.     (move .l SP A1)  ; save argument pointer we have 6 boot-args
  57.     (move .l ($ (fx+ (fixnum-ashl 6 8) header/general-vector)) (@-r SP))
  58.     (lea (d@r SP 2) A2)                                    ; second arg to boot
  59.     (move .l A2 (d@nil slink/boot-args))                 ; set up boot-args
  60.  
  61.     (move .l (d@static P (static 'm68-big-bang)) P)
  62.     (move .l (d@r P -2) A2)
  63.     (lea (label big-bang-return) TP)
  64. ;;; note that nil-reg is in AN and pointer to boot args in A1
  65.     (jmp (@r A2))                  
  66. big-bang-return
  67.     ;; initialize area,area-frontier and area-limit
  68.     (move .l (d@r A1 4) S0)         ; get address of heap
  69.     (move .l S0 (d@r TASK task/area-begin))          
  70.     (move .l S0 (d@r TASK task/area-frontier))       
  71.     (add .l (d@r A1 12) S0)         ; add size to base
  72.     (move .l S0 (d@r TASK task/area-limit))          
  73.  
  74.     ;; Set up the procedure register P and call boot,
  75.     ;; never to return. (note: arg 2 (*boot-args*) setup above)
  76.     (move .l nil-reg A3)
  77.     (tst .b (d@r A1 24))
  78.     (j= %debug)
  79.     (move .l ($ header/true) A3)
  80. %debug
  81.     (lea (d@r TASK %%task-header-offset) A1)          ; root-process
  82.     (move .l  ($ 4) NARGS)                            ; 3 args
  83.     (move .l  (d@static P (static '*boot*)) P)
  84.     (move .l  (d@r P -2) TP)
  85.     (jmp   (@r TP))))
  86.  
  87. (define (call-fault-handler)
  88.   (lap (signal-handler)
  89.  
  90.     (equate t-interrupt                     (fixnum-ashl 2 2))
  91.     (equate t-virtual-timer                 (fixnum-ashl 26 2))
  92.  
  93.     (move .l ($ t-interrupt) A1)
  94.     (btst ($ 1) (d@r TASK task/critical-count))                   
  95.     (jn= %call-fault)
  96.     (move .l ($ t-virtual-timer) A1)
  97. %call-fault                                
  98.     (lea (d@r SP 6) A2)
  99.     (move .l (d@static P (static 'signal-handler)) P)
  100.     (move .l (d@r P -2) TP)
  101.     (clr .b (d@r TASK task/critical-count))
  102.     (jmp (@r TP))))                                
  103.  
  104.  
  105. ;;;; Low-level exception handling
  106.  
  107. (lap-template (0 0 -1 t stack %fault-frame-handler)
  108. %fault-frame-template
  109.     (bset ($ 6) (d@r task task/critical-count))
  110.     (move .l (d@r SP 4) S0)                    ; fault header
  111.     (asr .l ($ 8) S0)
  112.     (add .l ($ 2) S0)                          ; 2 for header and template
  113.     (asl .l ($ 2) S0)
  114.     (tst .l (d@r SP 12))
  115.     (j= foobar)
  116.     (move .l (d@r SP 12) (index (@r SP) S0))   ; restore hacked top of stack
  117. foobar
  118.     (add .w ($ 16) sp)        ; pop template,header,pointers on stack,hack top
  119.     (move .l (d@r SP (* (+ *pointer-temps* *scratch-temps* 9) 4))
  120.              A1)                           ; context
  121.     (move .l (@r+ SP) (d@r A1 %%df_pc))
  122.     (move .l (@r+ SP) (d@r A1 %%df_a0))    ; P
  123.     (move .l (@r+ SP) (d@r A1 %%df_a1))    ; A1
  124.     (move .l (@r+ SP) (d@r A1 %%df_a2))    ; A2
  125.     (move .l (@r+ SP) (d@r A1 %%df_a3))    ; A3
  126.     (move .l (@r+ SP) (d@r A1 %%df_a4))    ; AN
  127.     (move .l (@r+ SP) (d@r A1 %%df_a5))    ; TP
  128.  
  129.     (move .l ($ -8) S0)
  130. %fault-restore-loop                                  ; restore temps
  131.     (move .l (@r+ SP) (index (@r TASK) S0))
  132.     (add .l ($ 4) S0)
  133.     (cmp .l ($ temp-block-size) S0)          
  134.     (j< %fault-restore-loop)
  135.     (add .w ($ 4) SP)                           ; pop context
  136.     (bclr ($ 6) (d@r task task/critical-count))
  137.     (rts)
  138. %fault-frame-handler
  139.     (move .l nil-reg an)
  140.     (rts))
  141.  
  142. (lap-template (0 0 -1 nil stack handle-foreign-return)
  143. %foreign-return
  144.     (bset ($ 6) (d@r task task/critical-count))
  145.     (add .w ($ 8) sp)                         ; pop template,header
  146.     (move .l (@r+ SP) (d@r TASK task/foreign-call-cont))
  147.     (bclr ($ 6) (d@r task task/critical-count))
  148.     (rts)
  149. handle-foreign-return
  150.     (move .l nil-reg AN)
  151.     (rts))
  152.                  
  153.  
  154. (lap-template (0 0 -1 nil stack handle-enable-return)
  155. %re-enabled
  156.     (add .w ($ 4) sp)                         ; pop return address
  157.     (rts)
  158. handle-enable-return
  159.     (move .l nil-reg AN)
  160.     (rts))
  161.  
  162. (lap-template (0 0 -1 nil stack handle-doing-gc-return)
  163. %doing-gc-return
  164.     (add .w ($ 4) sp)                         ; pop return address
  165.     (rts)
  166. handle-doing-gc-return
  167.     (move .l nil-reg AN)
  168.     (rts))
  169.  
  170. ;;; Interrupts can be deferred.   
  171. ;;; the task/critical count byte has
  172. ;;; bit 7 -- interrupts deferred
  173. ;;; bit 6 -- interrupts ignored
  174. ;;; bit 1 -- quit pending
  175. ;;; bit 0 -- timer interrupt pending
  176.  
  177. (define (interrupt_dispatcher)    ; code in S0, context in A1 
  178.   (lap (signal-handler enable-signals gc_interrupt)
  179.  
  180.     (equate %%fault-sp-offset 8)               
  181.     (equate %%df_a0 -20)
  182.     (equate %%df_a1 -16)
  183.     (equate %%df_a2 -128)
  184.     (equate %%df_a3 -124)
  185.     (equate %%df_a4 -120)
  186.     (equate %%df_a5 -116)
  187.     (equate %%df_pc       12)
  188.     (equate fault-quit      3)
  189.     (equate fault-interrupt                   2)
  190.     (equate fault-virtual-timer               26)
  191.                                              
  192.     (move .l (d@static P (static '*the-slink*)) nil-reg)
  193.     (move .l nil-reg AN)                          ; move slink to a-reg
  194.     (move .l (d@r AN slink/current-task) task)    ; restore task
  195.     (btst ($ 6) (d@r task task/critical-count))
  196.     (jn= %ignore-interrupt)
  197.     (cmp .l ($ fault-virtual-timer) S0)             ; is this a timer interrupt?
  198.     (j= %timer)                                   
  199.     (cmp .l ($ fault-interrupt) S0)                   ; is this a ^q?
  200.     (jn= %fault)                                  ; if so ..
  201.     (cmp .l (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  202.     (jn= %doing-gc)                               ; if not ...
  203.     (tst .l (d@r TASK task/foreign-call-cont))
  204.     (jn= %fault)
  205.     (btst ($ 1) (d@r TASK task/critical-count))   ; is this the second one?                
  206.     (j= %set-interrupt-flag)                      ; if not, defer interrupt
  207.     (bclr ($ 1) (d@r TASK task/critical-count))
  208.     (tst .b (d@r TASK task/critical-count))       ; are interrupts deferred?
  209.     (j= %fault)             
  210. %set-interrupt-flag                      ; if so ...
  211.     (or .b ($ 2) (d@r TASK task/critical-count))  ; set quit bit 
  212.     (jbr %ignore-interrupt)
  213. %timer
  214.     (cmp .l (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  215.     (jn= %ignore-interrupt)
  216.     (tst .b (d@r TASK task/critical-count))
  217.     (j= %fault) 
  218.     (or .b ($ 1) (d@r TASK task/critical-count))  ; set timer bit 
  219. %ignore-interrupt 
  220.     (pea (label %re-enabled))                     ; re-enable interrupts
  221.     (move .l (d@static p (static 'enable-signals)) p)    ; DON'T CONS!!!
  222.     (move .l (d@r p -2) tp)
  223.     (jmp (@r tp))                                                       
  224.  
  225. %doing-gc
  226.     (pea (label %doing-gc-return))
  227.     (move .l (d@static p (static 'gc_interrupt)) p)   
  228.     (move .l (d@r p -2) tp)
  229.     (jmp (@r tp))                                                       
  230.  
  231.  
  232. ;;; Interrupts should be disabled here.
  233. %fault
  234.     (move .l (d@r task task/foreign-call-cont) S1)
  235.     (j=  %t-code-interrupt)
  236.  
  237.     ;; Interrupted out of foreign code.
  238.     (clr .l (d@r task task/foreign-call-cont))     
  239.     (move .l s1 (@-r sp))            ; push foreign continuation
  240.     (sub .l sp s1)                   ; compute frame size
  241.     (asl .l ($ 6) S1)
  242.     (move .b ($ (fx+ header/fault-frame 128)) S1)
  243.     (move .l s1 (@-r sp))            ; push frame size 
  244.     (pea (label %foreign-return))
  245.     (jbr %fault-done)
  246.                                  
  247. ;;; registers s4=fault-sp  a1=context
  248. %t-code-interrupt                    
  249.     (move .l A1 (@-r SP))                  ; save context
  250.     (move .l (d@r A1 %%fault-sp-offset) S4)        ; get fault SP in S4
  251.     (move .l S4 AN)                        ; save fault sp
  252.  
  253.     (move .l ($ (fx+ temp-block-size 4)) S2)
  254. %fault-save-loop                              ; save temps and extra p and s
  255.     (move .l (index (d@r TASK -8) S2) (@-r SP))
  256.     (sub .l ($ 4) S2)
  257.     (j>= %fault-save-loop)
  258.                                                                          
  259.     (move .l (d@r A1 %%df_a5) (@-r SP))        ; TP (a5)
  260.     (move .l (d@r A1 %%df_a4) (@-r SP))        ; AN (a4)
  261.     (move .l (d@r A1 %%df_a3) (@-r SP))        ; A3 
  262.     (move .l (d@r A1 %%df_a2) (@-r SP))        ; A2 
  263.     (move .l (d@r A1 %%df_a1) (@-r SP))        ; A1 
  264.     (move .l (d@r A1 %%df_a0) (@-r SP))        ; P  (a0)
  265.     (move .l (d@r A1 %%df_pc) S1)
  266.     (move .l S1 (@-r SP))
  267.     (move .l nil-reg A1)                                                                   
  268.     (cmp .l (d@r A1 slink/kernel-begin) S1)
  269.     (j< %not-in-kernel)
  270.     (cmp .l (d@r A1 slink/kernel-end) S1)
  271.     (j> %not-in-kernel)
  272.     (move .l (@r AN) (@-r SP))             ; save hack top of stack
  273.     (clr .l (@-r SP))                      ; no pointers on top
  274.     (jbr %t-code-done)
  275.  
  276. %not-in-kernel
  277.     (clr .l (@-r SP))                      ; no hacked stack top
  278.  
  279. ;;; find how many pointers on top of stack
  280.     (move .l ($ -4) s1)                    ; pointer slot counter as fixnum
  281.  
  282. %find-last-template-loop
  283.     (add .l ($ 4) s1)                      ; incr # pointer counter
  284.     (move .l (@r+ an) s2)                  ; load next word
  285.     (cmp .b ($ header/vframe) s2)          ; vframe?
  286.     (j= %found-frame)                         ; .. if so, done looking
  287.  
  288.     (move .w s2 s3)                        ; copy for extend test
  289.     (and .b ($ 3) s3)
  290.     (cmp .b ($ tag/extend) s3)             ; extend?
  291.     (jn=  %find-last-template-loop)        ; .. if not, keep looking
  292.     (move .l s2 a3)                        ; copy extend pointer to fetch tem
  293.     (move .l (d@r a3 -2) s3)               ; fetch template 
  294.     (jpos %find-last-template-loop)        ; .. if high bit is 0, keep looking
  295.  
  296. %found-frame
  297.     (move .l s1 (@-r sp))                  ; push number of pointers on stack
  298. %t-code-done
  299.     (sub .l sp s4)                         ; compute total size of frame
  300.     (asl .l ($ 6) s4)
  301.     (move .b ($ header/fault-frame) s4)
  302.     (move .l s4 (@-r SP))                  ; push fault header
  303.     (pea (label %fault-frame-template))         ; call fault handler
  304.  
  305. %fault-done                                            
  306.     (asl .l ($ 2) S0)
  307.     (move .l s0 a1)                             ; 1st argument is signal code
  308.     (lea (d@r SP 6) a2)                         ; 2nd argument is frame
  309.     (move .l (d@static p (static 'signal-handler)) p)   ; ...
  310.     (move .l (d@r p -2) tp)                     ; ...
  311.     (jmp (@r tp))                               ; ...
  312.  
  313.     ))                           
  314.                     
  315. (define (local-machine)
  316.   (object nil                               
  317.       ((machine-type self)          'sun)
  318.       ((page-size self)             2048)
  319.       ((object-file-type self)      'mo)
  320.       ((information-file-type self) 'mi)
  321.       ((noise-file-type self)       'mn)
  322.       ((print-type-string self)     "Machine")))
  323.  
  324. (define (nan? x)
  325.   (or (fx= (isnan x) 1)
  326.       (fx= (isinf x) 1)))
  327.  
  328. (define-foreign isnan (isnan (in rep/double)) rep/integer)
  329. (define-foreign isinf (isinf (in rep/double)) rep/integer)
  330.  
  331. (define (st_mtime stat-block)
  332.   (+ (ash (mref-16-u stat-block 28) 16) 
  333.      (mref-16-u stat-block 30)))
  334.  
  335. (define-integrable (st_size stat-block)
  336.   (mref-integer stat-block 16))
  337.  
  338.  
  339. (define-integrable (st_mode stat-block)
  340.   (mref-16-u stat-block 6))
  341.